#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the iControl Public License
# Version 4.5 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.f5.com/.
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is iControl Code and related documentation
# distributed by F5.
#
# The Initial Developer of the Original Code is F5 Networks,
# Inc. Seattle, WA, USA. Portions created by F5 are Copyright (C) 1996-2003 F5 Networks,
# Inc. All Rights Reserved.  iControl (TM) is a registered trademark of F5 Networks, Inc.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License (the "GPL"), in which case the
# provisions of GPL are applicable instead of those above.  If you wish
# to allow use of your version of this file only under the terms of the
# GPL and not to allow others to use your version of this file under the
# License, indicate your decision by deleting the provisions above and
# replace them with the notice and other provisions required by the GPL.
# If you do not delete the provisions above, a recipient may use your
# version of this file under either the License or the GPL.
#----------------------------------------------------------------------------

use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use POSIX;
# use SOAP::Lite + trace => qw(method debug);
use SOAP::Lite;
use BigIP::iControl;
use Data::Dumper;
use Net::FTP::File;
use Config::IniFiles;

###################
# Script Variable #
###################

my $script_name = 'F5 LTM - Export HTML';
my $author = 'Marc GUYARD <m.guyard@orange.com>';
my $version = '0.1';

#####################
# Default arguments #
#####################

my $show_version;
my $show_help;
my $show_man;
my $verbose;
my $configvars;
my $configuration_file;
my $LocalLBVirtualServer;
my $LocalLBRule;
my $LocalLBPool;
my $LocalLBPoolMember;
my $soapResponse;
my $urnMap = {
    "{urn:iControl}LocalLB.LBMethod" => 1,
    "{urn:iControl}LocalLB.MonitorRuleType" => 1,
    "{urn:iControl}LocalLB.ProfileContextType" => 1,
    "{urn:iControl}LocalLB.ProfileType" => 1,
    "{urn:iControl}LocalLB.VirtualServer.VirtualServerType" => 1,
};
my $today = strftime("%Y-%m-%d", localtime);
my $year = strftime("%Y", localtime);
my $month_letter = ucfirst(strftime("%B", localtime));
my $month = strftime("%m", localtime);
my $host;
my $username;
my $password;
my $customer_name;
my $customer_project;
my $output;


#############
# Functions #
#############

## Function to show the version
sub show_version {
	print "*** VERSION ***\n";
	print "Version : $version\n";
}

# Parse the config ini file
sub parse_configvars {
	my $section = $_[0];
	my $parameter = $_[1];
	my $var = substr $configvars->val( $section, $parameter ), 1, - 1;
	return $var;
}

sub HTML_Header() {
	# my ($output) = (@_);
	if (!defined($output)) {
		print "You need to specify in which file write the report !\n";
		exit 10;
	} else {
		open(HTMLHEADER,">$output");
		print HTMLHEADER '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" />';
		print HTMLHEADER '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="fr-FR">';
		print HTMLHEADER '<head>';
		print HTMLHEADER '<meta http-equiv="content-type" content="text/html; charset=UTF-8" />';
		print HTMLHEADER '<meta http-equiv="content-language" content="fr-FR" />';
		print HTMLHEADER '<title>Reporting F5 LTM</title>';
		print HTMLHEADER '<meta name="language" content="fr-FR" />';
		print HTMLHEADER '<meta name="robots" content="all" />';
		print HTMLHEADER '<meta name="description" content="Reporting Configuration F5 LTM" />';
		print HTMLHEADER '</head>';
		print HTMLHEADER '<div id="header" STYLE="width:100%;float:left;margin-top:20px;height:100px;">';
		print HTMLHEADER '<div id="logoOBS" STYLE="float:left;width:20%;text-align:center;"><img alt="" src="" /></div>';
		print HTMLHEADER '<div id="title" STYLE="float:left;width:60%;text-align:center;"><h1 style="color:#FF7900">'.$customer_name.' '.$customer_project.' - Configuration F5 LTM<h1></div>';
		print HTMLHEADER '<div id="logoF5" STYLE="float:left;width:20%;text-align:center;"><img alt="" width="30%" src="" /></div>';
		print HTMLHEADER '</div>';
		close (HTMLHEADER); 
	}
}

sub HTML_Footer() {
	# my ($output) = (@_);
	open(HTMLFOOTER,">>$output");
	print HTMLFOOTER '</body>';
	print HTMLFOOTER '</html>';
	close (HTMLFOOTER);
}

## Transport Information
sub SOAP::Transport::HTTP::Client::get_basic_credentials {
	return "$username" => "$password";
}

## Deserializer SOAP
no warnings 'redefine'; 
sub SOAP::Deserializer::typecast { 
	my ($self, $value, $name, $attrs, $children, $type) = @_; 
	my $retval = undef; 
	if (!defined $type) { 
		return $retval; 
	}
	if (!defined $urnMap->{$type}) { 
		return $retval; 
	} 
	if (1 == $urnMap->{$type} ) { 
		$retval = $value; 
	} 
	return $retval; 
}

## Launch Icontrol Interface
sub SetIControl() {
	my ($module, $name) = @_;
  
	my $interface = SOAP::Lite
		-> uri("urn:iControl:$module/$name")
		-> readable(1)
		-> proxy("https://$host/iControl/iControlPortal.cgi");
	eval {
		$interface->transport->http_request->header( 'Authorization' => 'Basic ' . MIME::Base64::encode("$username:$password", '') );
		$interface->transport->ssl_opts( SSL_verify_mode => 'SSL_VERIFY_NONE' );
	};

	return $interface;
}

## Check Response
sub checkResponse() {
	my ($soapResponse) = (@_);
	if ( $soapResponse->fault )
	{
		print $soapResponse->faultcode, " ", $soapResponse->faultstring, "\n";
		exit();
	}
}

## Get Irule
sub getiRuleContent() {
	my($rulename) = (@_);
	my $RuleDefinition;
	
	if ( $rulename eq "" ) {
		print "WARNING : Rulename EMPTY\n"
	} else {
		$soapResponse = $LocalLBRule->query_rule(
			SOAP::Data->name(rule_names => [$rulename])
		);
		&checkResponse($soapResponse);
		my @RuleDefinitionList = @{$soapResponse->result};
		$RuleDefinition = $RuleDefinitionList[0];
	}
	my $rule_name = $RuleDefinition->{"rule_name"};
	my $rule_definition = $RuleDefinition->{"rule_definition"};
	return $rule_definition;
}

sub getVS() {
	my %VS = ();
	my $VSname;
	my $VSdestination;
	$soapResponse = $LocalLBVirtualServer->get_list();
	&checkResponse($soapResponse);
	my @vs_list = @{$soapResponse->result};
	foreach $VSname (@vs_list) {
		$soapResponse = $LocalLBVirtualServer->get_destination(
			SOAP::Data->name (virtual_servers => [$VSname])
		);
		&checkResponse($soapResponse);
		my @destination_list = @{$soapResponse->result};
		my $VSdestinationIP = $destination_list[0]->{'address'};
		my $VSdestinationPORT = $destination_list[0]->{'port'};
		my $VSdestination = $VSdestinationIP.":".$VSdestinationPORT;
		$VS{$VSname} = $VSdestination;
	}
	return %VS;
}

sub getIRULE() {
	my($VS) = (@_);
	$soapResponse = $LocalLBVirtualServer->get_rule(
		SOAP::Data->name (virtual_servers => [$VS])
	);
	&checkResponse($soapResponse);
	my @irule_list = @{$soapResponse->result};
	return @irule_list;
}

sub getALLIRULES() {
	$soapResponse = $LocalLBRule->get_list;
	&checkResponse($soapResponse);
	my @all_irule_list = @{$soapResponse->result};
	return @all_irule_list;
}

sub getPROFILE() {
	my($VS) = (@_);
	$soapResponse = $LocalLBVirtualServer->get_profile(
		SOAP::Data->name(virtual_servers => [$VS])
	);
	&checkResponse($soapResponse);
	my @profile_list = @{$soapResponse->result};
	return @profile_list;
}

sub getPOOL() {
	my($VS) = (@_);
	$soapResponse = $LocalLBVirtualServer->get_default_pool_name(
		SOAP::Data->name (virtual_servers => [$VS])
	);
	&checkResponse($soapResponse);
	my @pool_list = @{$soapResponse->result};
	return @pool_list;
}

sub getALLPOOL() {
	$soapResponse = $LocalLBPool->get_list;
	&checkResponse($soapResponse);
	my @all_pool_list = @{$soapResponse->result};
	return @all_pool_list;
}

sub getPOOLMEMBERS() {
	my($poolname) = (@_);
	$soapResponse = $LocalLBPool->get_member(
		SOAP::Data->name(pool_names => [$poolname])
	);
	&checkResponse($soapResponse);
	my @member_list = @{$soapResponse->result};
	return @member_list;
}

sub getLBMETHOD() {
	my($poolname) = (@_);
	my @lbmethod_list;
	if ( $poolname ne "") {
		$soapResponse = $LocalLBPool->get_lb_method(
			SOAP::Data->name(pool_names => [$poolname])
		);
		&checkResponse($soapResponse);
		@lbmethod_list = @{$soapResponse->result};
	}
	return @lbmethod_list;
}

## Request Informations
sub requestF5 {
	$LocalLBVirtualServer = &SetIControl("LocalLB", "VirtualServer");
	$LocalLBRule = &SetIControl("LocalLB", "Rule");
	$LocalLBPool = &SetIControl("LocalLB", "Pool");
	$LocalLBPoolMember = &SetIControl("LocalLB", "PoolMember");
	open(HTMLCONTENT,">>$output");
	print HTMLCONTENT "<div id='main' STYLE='width:100%;float:left;'>";
	print HTMLCONTENT "<h2 style='color:#FF7900;margin-left:5%;'><i>Liste des Virtual Servers<i></h2>";
	my %VS = &getVS;
	my @VS = sort keys(%VS);
	foreach my $VS (@VS) {
		my $VSname = $VS;
		my $VSaddress = $VS{$VS};
		print "VS=".$VSname." IP=".$VSaddress."\n" if ($verbose);
		print HTMLCONTENT "<h3 style='color:#444444;text-align:center;text-transform:uppercase;'>".$VSname.'</h3>';
		my @irule_list = &getIRULE($VSname);
		my @profile_list = &getPROFILE($VSname);
		my @pool_list = &getPOOL($VSname);
		my $poolname = $pool_list[0];
		# my @member_list = &getPOOLMEMBERS($poolname) if ($poolname ne "");
		my @lbmethod_list = &getLBMETHOD($poolname) if ($poolname ne "");
		# @member_list = @{$member_list[0]} if (@member_list);
		@irule_list = @{$irule_list[0]};
		@profile_list = @{$profile_list[0]};
		$lbmethod_list[0] = "" if ( !defined($lbmethod_list[0]) );
		# print Dumper(@member_list);
		print "Pool Name : ".$poolname." / LB Method : ".$lbmethod_list[0]."\n" if ($verbose);
		print HTMLCONTENT "<div id='VS'><center><table width='50%' STYLE='border:thin solid;border-collapse:collapse;'><caption><i>Informations Virtual Server</i></caption>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'>Nom : </th><td style='border: thin solid;text-align: center;'>".$VSname."</td></tr>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'>Adresse IP/Port : </th><td style='border: thin solid;text-align: center;'>".$VSaddress."</td></tr>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'>Pool Name : </th><td style='border: thin solid;text-align: center;'><a href=#pool_".$poolname.">".$poolname."</a></td></tr>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'>Load-Balancing Method : </th><td style='border: thin solid;text-align: center;'>".$lbmethod_list[0]."</a></td></tr>";
		print HTMLCONTENT "</table></center></div>";
		# foreach my $member (@member_list) {
			# print "Member IP : ".$member->{'address'}." / Member Port : ".$member->{'port'}."\n" if ($verbose);
		# }
		print HTMLCONTENT "<br\>";
		print HTMLCONTENT "<center><div id='irules-vs'><table width='50%' STYLE='border:thin solid;border-collapse:collapse;'><caption><i>Irules</i></caption>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='border: thin solid #000;background-color: #FF7900;color: #fff;'>Nom</th><th style='border: thin solid #000;background-color: #FF7900;color: #fff;'>Priorit&eacute;</th></tr>";
		foreach my $irule (@irule_list) {
			print "Irule Name : ".$irule->{'rule_name'}." / Irule Priority : ".$irule->{'priority'}."\n" if ($verbose);
			print HTMLCONTENT "<tr style='border: thin solid;'><td style='border: thin solid;text-align: center;'><a href=#irule_".$irule->{'rule_name'}.">".$irule->{'rule_name'}."</a></td><td style='border: thin solid;text-align: center;'>".$irule->{'priority'}."</td></tr>";
		}
		print HTMLCONTENT "</table></div></center>";
		print HTMLCONTENT "<br\>";
		print HTMLCONTENT "<center><div id='profile-vs'><table width='50%' STYLE='border:thin solid;border-collapse:collapse;'><caption><i>Profils</i></caption>";
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'>Nom</th><th style='background-color: #FF7900;color: #fff;'>Contexte</th><th style='background-color: #FF7900;color: #fff;'>Type</th></tr>";
		foreach my $profile (@profile_list) {
			print "Profile Name : ".$profile->{'profile_name'}." / Profile contexte : ".$profile->{'profile_context'}." / Profile Type : ".$profile->{'profile_type'}."\n" if ($verbose);
			print HTMLCONTENT "<tr style='border: thin solid;'><td style='border: thin solid;text-align: center;'>".$profile->{'profile_name'}."</td><td style='border: thin solid;text-align: center;'>".$profile->{'profile_context'}."</td><td style='border: thin solid;text-align: center;'>".$profile->{'profile_type'}."</td></tr>";
		}
		print HTMLCONTENT "</table></div></center>";
		print HTMLCONTENT "<br\><br\>";
		print "*******************\n" if ($verbose);
	}
	print HTMLCONTENT "<h2 style='color:#FF7900;margin-left:5%;'><i>Liste des Pools<i></h2>";
	my @all_pool_list = &getALLPOOL;
	print HTMLCONTENT "<center><div id='pools'><table width='50%' STYLE='border:thin solid;border-collapse:collapse;'>";
	foreach my $poolname (@all_pool_list) {
		print HTMLCONTENT "<tr style='border: thin solid;'><th colspan='2' style='background-color: #FF7900;color: #fff;'><balise id='pool_".$poolname."'>".$poolname."</balise></td></tr>";
		my @member_list = &getPOOLMEMBERS($poolname);
		@member_list = @{$member_list[0]};
		foreach my $members (@member_list) {
			print HTMLCONTENT "<tr style='border: thin solid;'><td style='border: thin solid;text-align: center;'>".$members->{'address'}."</td><td style='border: thin solid;text-align: center;'>".$members->{'port'}."</td></tr>";
		}
	}
	print HTMLCONTENT "</table></div></center>";
	print HTMLCONTENT "<h2 style='color:#FF7900;margin-left:5%;'><i>Liste des Irules<i></h2>";
	my @all_irule_list = &getALLIRULES;
	print HTMLCONTENT "<center><div id='irules'><table width='50%' STYLE='border:thin solid;border-collapse:collapse;margin-bottom:20px'>";
	foreach my $irulename (@all_irule_list) {
		print HTMLCONTENT "<tr style='border: thin solid;'><th style='background-color: #FF7900;color: #fff;'><balise id='irule_".$irulename."'>".$irulename."</balise></td></tr>";
		my $irulecontent = &getiRuleContent($irulename);
		$irulecontent =~ s/\n/\n<br>/g;
		print HTMLCONTENT "<tr style='border: thin solid;'><td style='border: thin solid;text-align: left;padding-left: 20px'>".$irulecontent."</td></tr>";
	}
	print HTMLCONTENT "</table></div></center>";
	# print Dumper(@all_irule_list);
	print HTMLCONTENT "</div>";
	close (HTMLCONTENT);
}

sub send_ftp() {
	my($output) = (@_);
	my $ftp_server = &parse_configvars('ftp','ftp.server');
	my $ftp_username = &parse_configvars('ftp','ftp.user');
	my $ftp_password = &parse_configvars('ftp','ftp.password');
	my $ftp_path = &parse_configvars('ftp','ftp.path');
	my $debug = 0;
	$debug = 1 if ($verbose);
	my $ftp = Net::FTP->new($ftp_server, Debug => $verbose)
		or die "Cannot connect to ".$ftp_server." : $@";
	$ftp->login($ftp_username,$ftp_password)
		or die "Cannot login ", $ftp->message;
	$ftp->cwd($ftp_path) or die "Changement de repertoire impossible.";
	if(! $ftp->isdir($year."/".$month."-".$month_letter)) {
		$ftp->mkdir($year."/".$month."-".$month_letter, 1);
	}
	$ftp->cwd($year."/".$month."-".$month_letter);
	$ftp->put($output) or die "Upload impossible.";
	$ftp->quit;
	unlink($output);
}

##########
# Script #
##########

# Check If arguments are present
if ( @ARGV > 0 ) {
	# Parse Arguments
	GetOptions( 	
		"c|configuration=s" => \$configuration_file,
		"version" => \&show_version,
		"v|verbose" => \$verbose,
		"q|quiet" => sub { $verbose = 0 },
		"man" => \$show_man,
		"help|?" => \$show_help
	)
	# Show usage if no argument match
	or pod2usage({-message => "Argument unknown\n", -exitval => 1});
} else {
	# Show usage if no argument specified
	pod2usage({-message => "No argument specify\n", -exitval => 2});
}

# Show help usage
pod2usage(1) if $show_help;
# Show man usage
pod2usage(-verbose => 2) if $show_man;

# Call functions
$configvars = Config::IniFiles->new( -file => $configuration_file );
$host = &parse_configvars('device','device.ip');
$username = &parse_configvars('device','device.username');
$password = &parse_configvars('device','device.password');
$customer_name = &parse_configvars('customer','customer.name');
$customer_project = &parse_configvars('customer','customer.project');
$output = "/tmp/".$customer_name."_".$customer_project."_".$today.".html";
&HTML_Header;
&requestF5;
&HTML_Footer;
&send_ftp($output);

__END__

=head1 NAME
 
 F5 - LTM Report
 
 =head1 AUTHOR
 
 Script written by Marc GUYARD for Orange AIS <m.guyard@orange.com>.
 
 =head1 VERSION
 
 0.1 BETA PERL
 
 =head1 SYNOPSIS
 
 B<F5_LTM_Export.pl>
 
 Options:
 --configuration
 Specify the configuration file
 --version
 show script version (need to be the first option)
 --verbose
 active script verbose
 --quiet
 active script quiet mode
 --man
 full documentation
 --help
 brief help message
 
 =head1 OPTIONS
 
 =over 8
 
 =item B<--configuration>
 
 Specify the configuration file
 
 =item B<--version>
 
 Print script version and exit.
 
 =item B<--verbose>
 
 Activate verbose mode. Should be used with another argument.
 
 =item B<--quiet>
 
 Activate quiet mode. Should be used with another argument.
 
 =item B<--help>
 
 Print a brief help message and exits.
 
 =item B<--man>
 
 Prints the manual page and exits.
 
 =back
 
 =head1 DESCRIPTION
 
 B<This program> is use to generate F5 LTM Report for LTM managed by the Orange AIS NSOC.
 
 =head1 RETURN CODE
 
 Return Code :

=cut


